home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
015
/
prnter_2.arc
/
NECPRINT.BAS
< prev
next >
Wrap
BASIC Source File
|
1983-01-30
|
14KB
|
409 lines
10 REM NECPRINT - - A texteditor for the NEC PC-8023A printer
20 REM written by Hal R. Varian, 1114 Woodlawn Avenue, Ann Arbor, MI 48104
30 REM Copyright (c) 1982 by Hal R. Varian
40 DEFINT A-Z
50 REM greek characters and other special symbols
60 ALPHA$ = CHR$(192)
70 BETA$ = CHR$(195)
80 DELTA$ = CHR$(189)
90 PI$ = CHR$(202)
100 CAPSIGMA$ = CHR$(191)
110 PART$ = CHR$(159)
120 LAMBDA$ = CHR$(222)
130 TAU$ = CHR$(207)
140 APPROX$ = CHR$(210)
150 RHO$ = CHR$(183)
160 ETA$ = CHR$(197)
170 INFINITY$ = CHR$(176)
180 IOTA$ = CHR$(215)
190 GAMMA$ = CHR$(178)
200 EPSILON$ = CHR$(182)
210 RHO$ = CHR$(183)
220 PHI$ = CHR$(216)
230 SIGMA$ = CHR$(184)
240 NU$ = CHR$(193)
250 OMEGA$ = CHR$(209)
260 MU$ = CHR$(223)
270 KAPPA$ = CHR$(190)
280 XI$ = CHR$(196)
290 UPSILON$ = CHR$(201)
300 CAPLAMBDA$ = CHR$(203)
310 RADICAL$ = CHR$(211)
320 IOTA$ = CHR$(215)
330 CHI$ = CHR$(218)
340 ZETA$ = CHR$(221)
350 CAPDELTA$ = CHR$(194)
360 INTEGRAL$ = CHR$(242)
370 RTARROW$ = CHR$(171)
380 PSI$ = CHR$(185)
390 CAPOMEGA$ = CHR$(186)
400 CAPGAMMA$ = CHR$(187)
410 REM printer control strings
420 FORMFEED$ = CHR$(&H1F)+CHR$(1)
430 PROG$="NECPRINT v. 2.0 June, 1982"
440 ESC$ = CHR$(27)
450 CONDENSEON$ = ESC$+CHR$(&H51)
460 ENHANCEOFF$ = ESC$+CHR$(&H22)
470 ENHANCEON$ = ESC$+"!"
480 ELITEON$ = ESC$+CHR$(&H45)
490 PROPORTION$ = ESC$+CHR$(&H50)
500 LARGEON$ = CHR$(&HE)
510 LARGEOFF$ = CHR$(&HF)
520 UNDERLINEON$ = ESC$+CHR$(&H58)
530 UNDERLINEOFF$ = ESC$+CHR$(&H59)
540 PICAON$ = ESC$+CHR$(&H4E)
550 FORWARD$=ESC$+"f"
560 REVERSE$=ESC$+"r"
570 INCREM$ = ESC$+CHR$(&H5B)
580 SEEK$ = ESC$+CHR$(&H5D)
590 SINGLE$ = ESC$+"A"
600 CLRLPT$=ENHANCEOFF$+LARGEOFF$+UNDERLINEOFF$+PICAON$+ESC$+"L"+"005"+SINGLE$+SEEK$+FORWARD$
610 REM begin main program execution
620 REM clear printer
630 GOSUB 1800
640 REM
650 REM
660 REM *** Initial Menu ***
670 KEY OFF: CLS: SCREEN 0,0,0
680 PRINT PROG$: PRINT "Copyright (C) 1982 by Hal R. Varian":PRINT:PRINT
690 PRINT "Functions"
700 PRINT TAB(13);"P - Print a text file"
710 PRINT TAB(13);"Q - Quit and return to DOS"
720 PRINT TAB(13);"R - Reset printer"
730 PRINT TAB(13);"S - Set up printer"
740 PRINT TAB(13);"T - Advance paper to top"
750 PRINT TAB(13);"X - Exit to BASIC"
760 NEXTLN = CSRLIN+1
770 PLOC = NEXTLN: GOSUB 2110 'clear next line
780 INPUT "Enter function: ", X$: IF X$="" THEN BEEP: GOTO 770
790 GOSUB 2040 'capitalize x$
800 X = INSTR("PSRTQX",X$): IF X = 0 THEN BEEP: GOTO 770
810 ON X GOSUB 840,1370,1800,1920,1960,2000
820 GOTO 660 'present menu again
830 REM
840 REM print a text file
850 CLS
860 PRINT PROG$: PRINT
870 PRINT "Adjust the paper in the printer so that"
880 PRINT "the perforation is at the top of the print head."
890 PRINT
900 PRINT "Enter the exact filename.":PRINT
910 PRINT "Depress the RETURN key to begin printing."
920 PRINT "Enter a blank line to return to menu."
930 PRINT "Depress ESC key to abort printing."
940 PRINT
950 INPUT "Name of file to print: ",X$
960 IF LEN(X$) = 0 THEN RETURN
970 GOSUB 2040 ' capitalize x$
980 WIDTH "lpt1:", PWIDTH
990 OPEN X$ FOR INPUT AS 1
1000 PAGENR = STPAGE
1010 LINENR = 1
1020 IF EOF (1) THEN 1210
1030 LINE INPUT #1, L$
1040 REM see if this is correct place to start if sflg is set
1050 IF SFLG = 1 THEN SPLC=INSTR(L$,SLINE$): IF SPLC = 0 THEN GOTO 1020 ELSE SFLG = 0
1060 REM check for Greek characters,super and subscripts, and underlines
1070 GOSUB 2530 : GOSUB 3020: GOSUB 3570
1080 REM check if this string is a page control string
1090 IF LEFT$(L$,1)="#" THEN GOSUB 2240: GOTO 1020
1100 IF LINENR = 1 THEN GOSUB 1250 'print page heading
1110 LPRINT L$; 'print line
1120 REM print superscripts and subscripts if necessary
1130 IF SUPFLG = 1 THEN GOSUB 3320
1140 IF SUBFLG = 1 THEN GOSUB 3440
1150 IF INKEY$=ESC$ THEN 1210 'abort print if <esc> key is pressed
1160 LPRINT:IF SPACING = 2 THEN LPRINT
1170 LINENR = LINENR + SPACING
1180 IF LINENR > PLENGTH THEN LINENR = 1
1190 GOTO 1020
1200 REM
1210 REM Close file and return
1220 CLOSE
1230 GOTO 950
1240 REM
1250 REM Print page heading
1260 IF PAGENR <> STPAGE THEN LPRINT FORMFEED$;
1270 PAGENR = PAGENR + 1
1280 LPRINT:LPRINT
1290 LPRINT UNDERLINEOFF$; 'turn off underline
1300 IF HEADFLG = 1 AND PAGENR <> 1 THEN LPRINT X$; TAB(33);"-";PAGENR;"-";TAB(60);DATE$
1310 IF HEADFLG = 0 AND PAGENR <> 1 THEN LPRINT TAB(34);"-";PAGENR;"-"
1320 IF UNDERLINE = 1 THEN LPRINT UNDERLINEON$;
1330 LPRINT: LPRINT
1340 LINENR = 1
1350 RETURN
1360 REM
1370 REM Set printer controls
1380 CLS: PRINT PROG$
1390 PRINT: PRINT "Printer options available: "
1400 PRINT
1410 PRINT " A - Line spacing of 1/6 inch"
1420 PRINT " B - Line spacing of 1/8 inch"
1430 PRINT " C - Condensed Print"
1440 PRINT " D - Double Spaced"
1450 PRINT " E - Enhanced Print"
1460 PRINT " G - Set Page Length"
1470 PRINT " H - Print header on each page"
1480 PRINT " I - Incremental Mode"
1490 PRINT " L - Large Print"
1500 PRINT " M - Set Left Margin"
1510 PRINT " P - Pica Print"
1520 PRINT " R - Proportional Print"
1530 PRINT " S - Start at line other than first"
1540 PRINT " T - Elite Print"
1550 PRINT
1560 PRINT
1570 INPUT " Enter desired options: ",O$
1580 X$=O$: GOSUB 2040: O$=X$ 'capitalize
1590 LPRINT CLRLPT$; 'clear line printer
1600 IF INSTR(O$,"A") THEN LPRINT ESC$+"A";
1610 IF INSTR(O$,"B") THEN LPRINT ESC$+"B";
1620 IF INSTR(O$,"R") THEN LPRINT PROPORTION$;
1630 IF INSTR(O$,"C") THEN LPRINT CONDENSEON$; CHR$(&H1B);"B";: PWIDTH = 132
1640 IF INSTR(O$,"E") THEN LPRINT ENHANCEON$;
1650 IF INSTR(O$,"L") THEN LPRINT LARGEON$;
1660 IF INSTR(O$,"P") THEN LPRINT PICAON$;
1670 IF INSTR(O$,"M") THEN GOSUB 2170
1680 IF INSTR(O$,"D") THEN SPACING = 2
1690 IF INSTR(O$,"I") THEN LPRINT INCREM$;
1700 IF INSTR(O$,"T") THEN LPRINT ELITEON$;
1710 IF INSTR(O$,"G") THEN GOSUB 3930
1720 IF INSTR(O$,"F") THEN FEEDFLG = 1
1730 IF INSTR(O$,"S") THEN GOSUB 3960
1740 IF INSTR(O$,"H") THEN HEADFLG = 1
1750 PRINT
1760 PLOC=CSRLIN
1770 GOSUB 2110
1780 RETURN
1790 REM
1800 REM set printer to defaults
1810 PWIDTH = 80
1820 PLENGTH = 53
1830 PAGENR = 0
1840 UNDERLINE = 0
1850 HEADFLG = 0
1860 SFLG=0
1870 SPACING = 1
1880 LPRINT CLRLPT$;
1890 STPAGE = 0
1900 RETURN
1910 REM
1920 REM Form feed to printer
1930 LPRINT FORMFEED$
1940 RETURN
1950 REM
1960 REM Quit and return to DOS
1970 CLS
1980 SYSTEM
1990 REM
2000 REM *** Exit to BASIC
2010 CLS
2020 END
2030 REM
2040 REM Capitalize string in X$
2050 FOR X = 1 TO LEN(X$)
2060 XC$ = MID$(X$,X,1)
2070 IF "a" <=XC$ AND XC$ <= "z" THEN MID$(X$,X,1)=CHR$(ASC(XC$) - 32)
2080 NEXT X
2090 RETURN
2100 REM
2110 REM position at line number ploc and clear it
2120 LOCATE PLOC,1
2130 PRINT STRING$(40," ")
2140 LOCATE PLOC,1
2150 RETURN
2160 REM
2170 REM Set left margin
2180 PRINT: PRINT "Margin width is entered in 3 digits"
2190 PRINT "Example: 005"
2200 INPUT "Desired margin width";MARGIN$
2210 LPRINT ESC$+"L"+MARGIN$;
2220 RETURN
2230 REM
2240 REM page control subroutine
2250 REM is this a formfeed record?2260 PSN = INSTR(L$,"#F")
2270 IF PSN <> 1 GOTO 2300
2280 L$ = MID$(L$,3): GOSUB 1250:LINENR = 2:RETURN
2290 REM is this a header record?2300 PSN = INSTR(L$,"#*")
2310 IF PSN = 0 GOTO 2360
2320 PSN = PSN+2
2330 X$=MID$(L$,PSN)
2340 GOSUB 1250:RETURN
2350 REM is this a center/title record?2360 PSN = INSTR(L$,"#=")
2370 IF PSN= 0 GOTO 2440
2380 REM find the | marks which indicate <cr>
2390 BEGIN=3
2400 PSN=INSTR(BEGIN,L$,"|")
2410 IF PSN=0 THEN TITLE$=MID$(L$,BEGIN): GOSUB 2460: RETURN
2420 LNG = PSN-BEGIN:TITLE$=MID$(L$,BEGIN,LNG):GOSUB 2460: BEGIN=PSN+1
2430 GOTO 2400
2440 RETURN 'more page control commands can be added here
2450 REM
2460 REM center title and print it out
2470 LNG=LEN(TITLE$)
2480 SKIP = (PWIDTH - LNG)/2 - 2
2490 LPRINT TAB(SKIP);TITLE$
2500 LINENR=LINENR+1
2510 RETURN
2520 REM
2530 REM See if there are special characters in string
2540 STRT = 1
2550 PSN = INSTR(STRT,L$,"&")
2560 IF PSN = 0 THEN RETURN
2570 IF PSN = 1 THEN GOTO 2590 'can't be literal
2580 IF MID$(L$,PSN-1,1) = "!" THEN L$=MID$(L$,1,PSN-2)+MID$(L$,PSN): STRT = PSN + 1: GOTO 2550 'if preceded by ! take no action
2590 L$ = MID$(L$,1,PSN-1)+MID$(L$,PSN+1) 'eliminate &
2600 REM find the Greek character in list
2610 CHAR$ = MID$(L$,PSN,1)
2620 IF CHAR$ = "a" THEN CHAR$ = ALPHA$
2630 IF CHAR$ = "b" THEN CHAR$ = BETA$
2640 IF CHAR$ = "p" THEN CHAR$ = PI$
2650 IF CHAR$ = "d" THEN CHAR$ = DELTA$
2660 IF CHAR$ = "S" THEN CHAR$ = CAPSIGMA$
2670 IF CHAR$ = "`" THEN CHAR$ = PART$
2680 IF CHAR$ = "l" THEN CHAR$ = LAMBDA$
2690 IF CHAR$ = "i" THEN CHAR$ = IOTA$
2700 IF CHAR$ = "t" THEN CHAR$ = TAU$
2710 IF CHAR$ = "r" THEN CHAR$ = RHO$
2720 IF CHAR$ = "h" THEN CHAR$ = ETA$
2730 IF CHAR$ = "~" THEN CHAR$ = APPROX$
2740 IF CHAR$ = "-" THEN CHAR$ = INFINITY$
2750 IF CHAR$ = "g" THEN CHAR$ = GAMMA$
2760 IF CHAR$ = "e" THEN CHAR$ = EPSILON$
2770 IF CHAR$ = "r" THEN CHAR$ = RHO$
2780 IF CHAR$ = "s" THEN CHAR$ = SIGMA$
2790 IF CHAR$ = "n" THEN CHAR$ = NU$
2800 IF CHAR$ = "m" THEN CHAR$ = MU$
2810 IF CHAR$ = "D" THEN CHAR$ = CAPDELTA$
2820 IF CHAR$ = "w" THEN CHAR$ = OMEGA$
2830 IF CHAR$ = "k" THEN CHAR$ = KAPPA$
2840 IF CHAR$ = "x" THEN CHAR$ = XI$
2850 IF CHAR$ = "u" THEN CHAR$ = UPSILON$
2860 IF CHAR$ = "L" THEN CHAR$ = CAPLAMBDA$
2870 IF CHAR$ = "f" THEN CHAR$ = PHI$
2880 IF CHAR$ = "j" THEN CHAR$ = INTEGRAL$
2890 IF CHAR$ = "/" THEN CHAR$ = RTARROW$
2900 IF CHAR$ = "y" THEN CHAR$ = PSI$
2910 IF CHAR$ = "W" THEN CHAR$ = CAPOMEGA$
2920 IF CHAR$ = "z" THEN CHAR$ = ZETA$
2930 IF CHAR$ = "J" THEN CHAR$ = RADICAL$
2940 IF CHAR$ = "i" THEN CHAR$ = IOTA$
2950 IF CHAR$ = "c" THEN CHAR$ = CHI$
2960 IF CHAR$ = "G" THEN CHAR$ = CAPGAMMA$
2970 REM More character's can be added here
2980 MID$(L$,PSN,1) = CHAR$ 'substitute Greek character
2990 GOTO 2550 'check for more Greek characters
3000 RETURN
3010 REM
3020 REM check for superscripts
3030 SUPFLG = 0
3040 SUPER$ = SPACE$(PWIDTH) ' this will contain the superscripts
3050 STRT = 1
3060 PSN = INSTR(STRT,L$,"$")
3070 IF PSN = 0 GOTO 3160
3080 IF PSN=1 GOTO 3100
3090 IF MID$(L$,PSN-1,1) = "!" THEN L$=MID$(L$,1,PSN-2)+MID$(L$,PSN): STRT = PSN + 1: GOTO 3060 ' ignore if preceded by !
3100 IF MID$(L$,PSN+1,1) = "(" THEN GOSUB 3710: GOTO 3060 'if more than one superscript goto subroutine 3790
3110 MID$(SUPER$,PSN,1) = MID$(L$,PSN+1,1)
3120 L$ = MID$(L$,1,PSN-1) + SPACE$(1) + MID$(L$,PSN+2)
3130 SUPFLG = 1
3140 GOTO 3060
3150 REM
3160 REM check for subscripts
3170 SUBFLG = 0
3180 SUB$ = SPACE$(PWIDTH)
3190 STRT = 1
3200 PSN = INSTR(STRT,L$,"@")
3210 IF PSN = 0 THEN RETURN
3220 IF PSN = 1 THEN 3240
3230 IF MID$(L$,PSN-1,1) = "!" THEN L$=MID$(L$,1,PSN-2)+MID$(L$,PSN): STRT = PSN + 1: GOTO 3200
3240 IF MID$(L$,PSN+1,1) = "(" THEN GOSUB 3770: GOTO 3200
3250 MID$(SUB$,PSN,1) = MID$(L$,PSN+1,1)
3260 L$ = MID$(L$,1,PSN-1) + SPACE$(1) + MID$(L$,PSN+2)
3270 SUPER$ = MID$(SUPER$,1,PSN-1) + SPACE$(1) + MID$(SUPER$,PSN+2)
3280 SUBFLG = 1
3290 GOTO 3200
3300 REM
3310 REM
3320 REM print superscripts
3330 SCRIPT$ = SUPER$:GOSUB 4020:SUPER$ = SCRIPT$ 'truncate trailing blanks
3340 LPRINT INCREM$; 'switch into incremental mode
3350 LPRINT ESC$;"T";"18"; 'set line spacing
3360 LPRINT REVERSE$
3370 LPRINT SUPER$;
3380 LPRINT FORWARD$
3390 LPRINT ESC$+"A"; 'return to standard spacing
3400 SUPFLG = 0
3410 LPRINT SEEK$; 'return to logic seeking mode
3420 RETURN
3430 REM
3440 REM print subscripts
3450 SCRIPT$ = SUB$:GOSUB 4020:SUB$ = SCRIPT$ 'truncate trailing blanks
3460 LPRINT INCREM$; 'switch to incremental mode
3470 LPRINT ESC$;"T";"13"; 'set line spacing
3480 LPRINT FORWARD$
3490 LPRINT SUB$;
3500 LPRINT REVERSE$
3510 LPRINT FORWARD$;
3520 LPRINT ESC$+"A"; 'return to standard spacing
3530 SUBFLG = 0
3540 LPRINT SEEK$; 'return to logic seeking mode
3550 RETURN
3560 REM
3570 REM underline routine
3580 STRT = 1
3590 PSN = INSTR(STRT,L$,"_")
3600 IF PSN = 0 THEN RETURN
3610 IF PSN = 1 THEN 3630 ' cannot be literal if in position 1
3620 IF MID$(L$,PSN-1,1) = "!" THEN L$=MID$(L$,1,PSN-2)+MID$(L$,PSN): STRT = PSN+1: GOTO 3590
3630 IF UNDERLINE = 0 THEN L$=MID$(L$,1,PSN-1)+UNDERLINEON$+MID$(L$,PSN+1):UNDERLINE=1:GOSUB 3660:GOTO 3590
3640 IF UNDERLINE = 1 THEN L$=MID$(L$,1,PSN-1)+UNDERLINEOFF$+MID$(L$,PSN+1):UNDERLINE = 0: GOSUB 3660: GOTO 3590
3650 REM
3660 REM fix the spacing in super$ and sub$
3670 SUPER$ = MID$(SUPER$,1,PSN-1)+MID$(SUPER$,PSN+1)
3680 SUB$ = MID$(SUB$,1,PSN-1)+MID$(SUB$,PSN+1)
3690 RETURN
3700 REM
3710 REM handle more than one superscript
3720 GOSUB 3840
3730 MID$(SUPER$,PSN,NCHAR) = MID$(L$,PSN+2,NCHAR)
3740 L$ = MID$(L$,1,PSN-1) + SPACE$(NCHAR) + MID$(L$,PSN+NCHAR+3)
3750 SUPFLG = 1
3760 RETURN
3770 REM handle more than one subscript
3780 GOSUB 3840
3790 MID$(SUB$,PSN,NCHAR) = MID$(L$,PSN+2,NCHAR)
3800 L$ = MID$(L$,1,PSN-1) + SPACE$(NCHAR) + MID$(L$,PSN+NCHAR+3)
3810 SUPER$ = MID$(SUPER$,1,PSN-1) + SPACE$(NCHAR) + MID$(SUPER$,PSN+NCHAR+3)
3820 SUBFLG = 1
3830 RETURN
3840 REM count characters between two parentheses
3850 PAR% = 1
3860 PLACE = PSN + 2
3870 IF PLACE > 80 THEN NCHAR = 2:RETURN 'error
3880 IF MID$(L$,PLACE,1) = ")" THEN PAR% = PAR% - 1
3890 IF MID$(L$,PLACE,1) = "(" THEN PAR% = PAR% + 1
3900 IF PAR% <> 0 THEN PLACE = PLACE + 1: GOTO 3870
3910 NCHAR = PLACE - PSN - 2
3920 RETURN
3930 REM set page length
3940 PRINT: INPUT "Page length in lines"; PLENGTH
3950 RETURN
3960 REM setup for starting place other than line 1, page 1
3970 SFLG = 1
3980 CLS
3990 INPUT "Starting page number";STPAGE: STPAGE = STPAGE - 1
4000 INPUT "Starting string";SLINE$
4010 RETURN
4020 REM truncate blanks at end of script$
4030 LENGTH = LEN(SCRIPT$) - 1
4040 IF RIGHT$(SCRIPT$,1) = " " THEN SCRIPT$ = LEFT$(SCRIPT$,LENGTH): GOTO 4030
4050 RETURN
4060 REM end of program
65399 '** DONE - PRESS ENTER TO RETURN TO MENU **
$ = LEFT$(SCRIPT$,LENGTH): GOTO 4030
4050 RETURN
4060 REM end of program
65399 '** DONE - PRESS ENTER TO RETURN